VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmHTMLEditor
Caption = "Bernie's Simple HTML Editor"
ClientHeight = 6390
ClientLeft = 1830
ClientTop = 2235
ClientWidth = 7485
Icon = "frmHTMLEditor.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6390
ScaleWidth = 7485
Begin VB.CommandButton cmdBTApproved
Caption = "BT Scheme"
Height = 495
Left = 2400
TabIndex = 17
Top = 3840
Visible = 0 'False
Width = 1095
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4560
Top = 3600
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox txtPicture
Height = 285
Left = 3840
TabIndex = 15
Top = 3240
Visible = 0 'False
Width = 1650
End
Begin VB.CommandButton cmdPicture
Caption = "?"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5520
TabIndex = 14
Top = 3240
Visible = 0 'False
Width = 255
End
Begin VB.CommandButton cmdCancelColor
Caption = "&Cancel"
Height = 495
Left = 3600
TabIndex = 13
Top = 3840
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton cmdColorDone
Caption = "&Done"
Height = 495
Left = 4800
TabIndex = 12
Top = 3840
Visible = 0 'False
Width = 1095
End
Begin VB.ComboBox Combo4
Height = 315
Left = 3840
TabIndex = 7
Top = 2880
Visible = 0 'False
Width = 1935
End
Begin VB.ComboBox Combo3
Height = 315
Left = 3840
TabIndex = 6
Top = 2520
Visible = 0 'False
Width = 1935
End
Begin VB.ComboBox Combo2
Height = 315
Left = 3840
TabIndex = 5
Top = 2160
Visible = 0 'False
Width = 1935
End
Begin VB.ComboBox Combo1
Height = 315
Left = 3840
TabIndex = 4
Top = 1800
Visible = 0 'False
Width = 1935
End
Begin SHDocVwCtl.WebBrowser WebBrowser1
Height = 1095
Left = 120
TabIndex = 3
Top = 840
Visible = 0 'False
Width = 2415
ExtentX = 4260
ExtentY = 1931
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = ""
End
Begin RichTextLib.RichTextBox rtbHTML
Height = 2055
Left = 120
TabIndex = 2
Top = 840
Visible = 0 'False
Width = 1575
_ExtentX = 2778
_ExtentY = 3625
_Version = 393217
ScrollBars = 3
TextRTF = $"frmHTMLEditor.frx":0442
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 630
Left = 0
TabIndex = 1
Top = 0
Width = 7485
_ExtentX = 13203
_ExtentY = 1111
ButtonWidth = 1191
ButtonHeight = 953
Appearance = 1
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 4
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "Editor"
Key = "Editor"
Description = "Editor"
Object.ToolTipText = "HTML Edit Mode"
BeginProperty ButtonMenus {66833FEC-8583-11D1-B16A-00C0F0283628}
NumButtonMenus = 1
BeginProperty ButtonMenu1 {66833FEE-8583-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "Preview"
Key = "Preview"
Description = "Preview"
Object.ToolTipText = "Preview HTML creation"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "Exit"
Key = "Exit"
Description = "EXIT"
Object.ToolTipText = "Exit"
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 0
Top = 6015
Width = 7485
_ExtentX = 13203
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.Label Label1
Caption = "Background Pic:"
Height = 255
Index = 4
Left = 2520
TabIndex = 16
Top = 3240
Visible = 0 'False
Width = 1215
End
Begin VB.Label Label1
Caption = "Visited Link:"
Height = 255
Index = 3
Left = 2520
TabIndex = 11
Top = 2880
Visible = 0 'False
Width = 855
End
Begin VB.Label Label1
Caption = "Unvisited Link:"
Height = 255
Index = 2
Left = 2520
TabIndex = 10
Top = 2520
Visible = 0 'False
Width = 1095
End
Begin VB.Label Label1
Caption = "Text:"
Height = 255
Index = 1
Left = 2520
TabIndex = 9
Top = 2160
Visible = 0 'False
Width = 615
End
Begin VB.Label Label1
Caption = "Background:"
Height = 255
Index = 0
Left = 2520
TabIndex = 8
Top = 1800
Visible = 0 'False
Width = 975
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileInsert
Caption = "&Insert HTML Page"
End
Begin VB.Menu mnuFileLoad
Caption = "&Load HTML Page"
End
Begin VB.Menu mnuFileSaveHTML
Caption = "&Save HTML Page"
End
Begin VB.Menu mnuFileSep1
Caption = "-"
End
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuHTML
Caption = "HTML Elements"
Begin VB.Menu mnuHTMLReturn
Caption = "Hard Return"
End
Begin VB.Menu mnuHTMLTable
Caption = "Table"
End
Begin VB.Menu mnuHTMLLinks
Caption = "Table with links"
End
Begin VB.Menu mnuHTMLVertical
Caption = "Vertical Frames"
End
Begin VB.Menu mnuHTMLHorizontal
Caption = "Horizontal Frames"
End
Begin VB.Menu mnuHTMLPicture
Caption = "Picture"
End
Begin VB.Menu mnuHTMLColorScheme
Caption = "BODY Color Scheme"
End
End
Attribute VB_Name = "frmHTMLEditor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Dim HTMLData As Boolean
Private Sub cmdBTApproved_Click()
'
Combo1.Text = "Tan"
Combo2.Text = "Maroon"
Combo3.Text = "Yellow"
Combo4.Text = "Blue"
End Sub
Private Sub cmdCancelColor_Click()
rtbHTML.Visible = True
ColorsOff
End Sub
Private Sub cmdColorDone_Click()
rtbHTML.Visible = True
ColorsOff
' rtbHTML.SelLength = 1
rtbHTML.SelRTF = BodyColorScheme
End Sub
Private Sub cmdPicture_Click()
frmHTMLEditor.txtPicture.Text = PickAPicture
End Sub
Private Sub Form_Resize()
If frmHTMLEditor.WindowState <> vbMinimized Then
Dim Hght As Long
Dim Wid As Long
Hght = frmHTMLEditor.Height - 2055
Wid = frmHTMLEditor.Width - 360
rtbHTML.Height = Hght
rtbHTML.Width = Wid
WebBrowser1.Height = Hght
WebBrowser1.Width = Wid
End If
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub mnuFileInsert_Click()
HTMLData = True
LoadAPage (False)
End Sub
Private Sub mnuFileLoad_Click()
HTMLData = True
LoadAPage (True)
End Sub
Private Sub mnuFileSaveHTML_Click()
SaveAPage
End Sub
Private Sub mnuHTMLColorScheme_Click()
If rtbHTML.Visible = True Then
ColorsOn
Combo1.Clear
Combo2.Clear
Combo3.Clear
Combo4.Clear
StuffColors Combo1
StuffColors Combo2
StuffColors Combo3
StuffColors Combo4
End If
End Sub
Private Sub mnuHTMLLinks_Click()
If rtbHTML.Visible = True Then
rtbHTML.SelLength = 0
'rtbHTML.SelRTF = AddLinkTable(4, 3, "Link Table Title")
rtbHTML.SelRTF = AddLinkTable(CLng(InputBox("Number of Columns", "Column Count", "3")), CLng(InputBox("Number of Rows", "Row Count", "4")), InputBox("Table Title", "Title of Table", "Table"))
End If
End Sub
Private Sub mnuHTMLPicture_Click()
If rtbHTML.Visible Then
'AddPicElement InputBox("Enter picture name:", "Picture Name", "bt2b2.gif"), CInt(InputBox("Border Value", "Border Value", "0"))
'
rtbHTML.SelLength = 0
Dim temp$
temp$ = AddPicElement(InputBox("Enter picture name:", "Picture Name", "bt2b2.gif"), CInt(InputBox("Border Value", "Border Value", "0")))
rtbHTML.SelRTF = temp$
End If
End Sub
Private Sub mnuHTMLReturn_Click()
If rtbHTML.Visible = True Then
rtbHTML.SelLength = 0
rtbHTML.SelRTF = "
" & vbCrLf
End If
End Sub
Private Sub mnuHTMLTable_Click()
If rtbHTML.Visible = True Then
rtbHTML.SelLength = 0
rtbHTML.SelRTF = AddTable(CLng(InputBox("Number of Columns", "Column Count", "3")), CLng(InputBox("Number of Rows", "Row Count", "4")), InputBox("Table Title", "Title of Table", "Table"))
End If
End Sub
Private Sub rtbHTML_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And Shift = 2 Then
If rtbHTML.Visible = True Then
rtbHTML.SelLength = 0
rtbHTML.SelRTF = "
" & vbCrLf
KeyCode = 0
End If
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "Exit"
Unload Me
Case "Browser"
'WebBrowser1.Visible = True
'rtbHTML.Visible = False
Case "Editor"
If HTMLData = False Or Len(rtbHTML.Text) < 1 Then
rtbHTML.Text = "" & vbCrLf & vbCrLf & "" & vbCrLf & "" & "Web Page Title" & vbCrLf & "" & vbCrLf & vbCrLf & "" & vbCrLf & vbCrLf & "" & vbCrLf & vbCrLf & ""
HTMLData = True
End If
WebBrowser1.Visible = False
rtbHTML.Visible = True
Case "Preview"
If HTMLData = True Then
Dim temp$
temp$ = App.Path
If Right(temp$, 1) <> "\" Then temp$ = temp$ & "\"
Open temp$ & "preview.html" For Output As #1
Print #1, rtbHTML.Text
Close #1
WebBrowser1.Visible = True
rtbHTML.Visible = False
WebBrowser1.Navigate temp$ & "preview.html"
Else
MsgBox "There is no HTML data to preview!", vbOKOnly + vbInformation
End If
End Select
End Sub